:- import "%%/scom/emitter.sl" #
:- import "%%/asm/dumper.sl" #
:- import "%%/asm/platform.sl" #
:- import "%%/asm/tables.sl" #


-- Rules Feed-in --

Generate .rules :-
	forall (list.member .rules .rule) (Generate.Rule .rule) #

Generate.Rule (DEF .call .pred) :- !
	Generate.CallLabel .call,
	Generate.Predicate .pred #
Generate.Rule (.fact) :-
	Generate.CallLabel .fact,
	Config.PointerSize .ps,
	Emit ("ADD" (GR .ps 4) (IMM .ps)),
	Emit ("JMP" (MEM (GR .ps 7) $ 1 0)) #

Generate.CallLabel .call :-
	Call.Signature .call .sign,
	Signature.Label .sign .label,
	Emit .label #


-- Code Generation --

	-- ESP (system stack) saves previous choice point locations and locals
	-- EDI (predicate stack) saves predicate return locations and their ESP

	-- For calling a non-deterministic predicate, successful calls would
	--  perform call operation to EDI stack top; on the other hand, a simple
	--  procedural return means invocation failed
Generate.Predicate .tree :-
	Config.PointerSize .ps, let .ps2 (.ps * 2),
	Label.New .cutPoint, set CUTPOINT .cutPoint,
	Emit ("MOV" (MEM (GR .ps 7) $ 1 4) (GR .ps 4)), -- Saves ESP
	Emit ("ADD" (GR .ps 7) (IMM .ps2)), -- Push to store newer return points
	Generate.Clause .tree $,
	Emit .cutPoint,
	Emit ("SUB" (GR .ps 7) (IMM .ps2)), -- Predicate failed, restores ESP
	Emit ("MOV" (GR .ps 4) (MEM (GR .ps 7) $ 1 4)),
	Emit "RET" #

	-- For general clauses, proceed means fail; do specified action if success
Generate.Clause $ $ :-
	Config.PointerSize .ps, let .ps2 (.ps * 2),
	Emit ("SUB" (GR .ps 7) (IMM .ps2)),
	Emit ("CALL" (MEM (GR .ps 7) $ 1 0)) ! #

Generate.Clause (INVOKE .routine) $ :-
	Emit ("CALL" .routine) ! #

Generate.Clause $ .action :-
	Generate.Clause .action $ ! #

Generate.Clause (AND .cl $) .action :-
	Generate.Clause .cl .action ! #

Generate.Clause (AND .cl1 .cl2) .action :-
	Generate.Clause .cl1 (AND .cl2 .action) ! #

Generate.Clause (OR .cl1 .cl2) .action :-
	Label.New .success, Label.New .fail,
	Generate.Clause .cl1 (INVOKE .success),
	Generate.Clause .cl2 (INVOKE .success),
	Emit ("JMP" .fail),
	Emit .success,
	Generate.Clause .action $,
	Emit "RET",
	Emit .fail ! #


-- System Predicates --

Generate.Clause (ID "cut") .action :- !
	Generate.Clause .action $,
	get CUTPOINT .cutPoint,
	Emit ("JMP" .cutPoint) #

Generate.Clause (ID "fail") . :- ! #

Generate.Clause (ID "repeat") .action :- !
	Label.New .retry, Emit .retry,
	Generate.Clause .action $,
	Emit ("JMP" .retry) #

Generate.Clause (ID "yes") .action :- Generate.Clause $ .action ! #

Generate.Clause (SYM "!") .action :-
	Generate.Clause (ID "cut") .action #

	-- Simple non-deterministic user predicate call
Generate.Clause .call .action :- !
	Call.Signature .call .sign, Signature.Label .sign .label,

	Config.PointerSize .ps,
	Label.New .fail, Label.New .success,
	Emit ("MOV" (MEM (GR .ps 7) $ 1 0) .success), -- Puts new return point
	Emit ("CALL" .label),
	Emit ("JMP" .fail),
	Emit .success,
	Generate.Clause .action $,
	Emit "RET", -- Retry the user predicate
	Emit .fail #


-- Miscellaneous --

Label.New (LABEL .label) :-
	temporary .labelNo,
	concat "L" .labelNo .label ! #

	-- Use Prolog convention, name and number of parameters
Call.Signature (ID .name) (SIGNATURE .name 0) :- ! #
Call.Signature .call (SIGNATURE .name .n) :-
	is.tuple .call,
	nth .call 0 (ID .name),
	length .call .len,
	let .n (.len - 1) #

Signature.Label (SIGNATURE .name .n) (LABEL .label) :-
	concat .name "$" .n .label #
